home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / CUSTEXAM.PRG < prev    next >
Encoding:
Text File  |  1990-06-16  |  16.5 KB  |  616 lines
  1. **********************************************************************
  2. * Program......: CUSTEXAM.PRG
  3. * Author.......:          This is an APPLICATION OBJECT.
  4. * Date.........: 12-04-88
  5. * Notice.......: Type information here or greetings to your users.
  6. * dBASE Ver....: See Application menu to use as sign-on banner.
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Customer Application Example
  9.  
  10. * Description..: Main routine for menu system
  11. **********************************************************************
  12.  
  13. *-- Setup environment
  14. SET CONSOLE OFF
  15. IF TYPE("gn_ApGen")="U"
  16.    CLEAR ALL
  17.    CLEAR WINDOWS
  18.    CLOSE ALL
  19.    CLOSE PROCEDURE
  20.    gn_ApGen=1
  21. ELSE
  22.    gn_ApGen=gn_ApGen+1
  23.    IF gn_ApGen > 4
  24.       Do Pause WITH "Maximum level of Application nesting exceeded."
  25.       RETURN
  26.    ENDIF
  27.    PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
  28.            gc_instruc, gc_safety, gc_status, gc_score, gc_talk, gc_key
  29. ENDIF
  30. *-- Store some sets to variables
  31. gc_bell   =SET("BELL")
  32. gc_carry  =SET("CARRY")
  33. gc_clock  =SET("CLOCK")
  34. gc_century=SET("CENTURY")
  35. gc_confirm=SET("CONFIRM")
  36. gc_deli   =SET("DELIMITERS")
  37. gc_instruc=SET("INSTRUCT")
  38. gc_safety =SET("SAFETY")
  39. gc_status =SET("STATUS")
  40. gc_score  =SET("SCOREBOARD")
  41. gc_talk   =SET("TALK")
  42. SET CONSOLE ON
  43.  
  44. SET BELL ON
  45. SET CARRY OFF
  46. SET CENTURY OFF
  47. SET CLOCK OFF
  48. SET CONFIRM OFF
  49. SET DELIMITERS TO ""
  50. SET DELIMITERS OFF
  51. SET DEVICE TO SCREEN
  52. SET ESCAPE ON
  53. SET EXCLUSIVE OFF
  54. ***SET ECHO OFF && remove for RunTime
  55. SET LOCK ON
  56. SET MESSAGE TO ""
  57. SET PRINT OFF
  58. SET REPROCESS TO 4
  59. SET SAFETY ON
  60. SET TALK OFF
  61.  
  62. *-- Initialize global variables
  63. gn_error=0          && 0 if no error, otherwise an error occurred
  64. gn_ikey=0           && keypress returned from the INKEY() function
  65. gn_send=0           && return value from popup of position menus
  66. gn_trace=1          && sets trace level, however you need to change template
  67. gc_brdr='1'         && border to use when drawing boxes
  68. gc_dev='CON'        && Device to use for printing - See Proc. PrintSet
  69. gc_key='N'          && leave the application
  70. gc_prognum='  '     && internal program counter to handle nested menus
  71. gc_quit=' '         && memvar for return to caller
  72. listval='NO_FIELD'  && Pick List value
  73.  
  74. *-- remove asterisk to turn clock on
  75. * SET CLOCK TO
  76. ***SET INSTRUCT OFF && remove for RunTime
  77. *-- Blank the screen
  78. SET COLOR TO
  79. CLEAR
  80. SET SCOREBOARD OFF
  81. SET STATUS OFF
  82.  
  83. *-- Define menus
  84. DO MPDEF            && execute Menu Process DEFinition
  85.  
  86. *-- Execute main menu
  87. DO WHILE gc_key = 'N'
  88.    DO CUSTMENU WITH "B00"
  89.    IF gc_quit = 'Q'
  90.       EXIT
  91.    ENDIF
  92.    ACTIVATE WINDOW Exit_App
  93.    lc_conf=SET("CONFIRM")
  94.    lc_deli=SET("DELIMITER")
  95.    SET CONFIRM OFF
  96.    SET DELIMITER OFF
  97.    @ 1,2 SAY "Do you want to leave this application?" ;
  98.          GET gc_key PICT "!" VALID gc_key $ "NY"
  99.    READ
  100.    SET CONFIRM &lc_conf.
  101.    SET DELIMITER &lc_deli.
  102.    RELEASE lc_conf, lc_deli
  103.    DEACTIVATE WINDOW Exit_App
  104. ENDDO
  105.  
  106. *-- Reset environment
  107. gn_ApGen=gn_ApGen-1
  108. SET BELL  &gc_bell.
  109. SET CARRY &gc_carry.
  110. SET CLOCK &gc_clock.
  111. SET CENTURY &gc_century.
  112. SET CONFIRM &gc_confirm.
  113. SET DELIMITERS &gc_deli.
  114. ***SET INSTRUCT &gc_instruc. && remove for RunTime
  115. SET STATUS &gc_status.
  116. SET SAFETY &gc_safety.
  117. SET SCORE  &gc_score.
  118. SET TALK   &gc_talk.
  119.  
  120. IF gn_Apgen < 1
  121.    ON KEY LABEL F1
  122.    CLEAR ALL
  123.    CLEAR WINDOWS
  124.    CLOSE ALL
  125.    CLOSE PROCEDURE
  126.    SET CLOCK OFF
  127.    SET ESCAPE ON
  128.    SET MESSAGE TO ""
  129.    CLEAR
  130. ENDIF
  131. RETURN
  132.  
  133. *******************************************************************************
  134. * Description..: Procedure files for generated menu system.
  135. * The programs that follow are common to main routines
  136. * The last procedure is the Menu Process DEFinition
  137. *******************************************************************************
  138. PROCEDURE Lockit
  139. PARAMETER ltype
  140. IF NETWORK()
  141.    gn_error=0
  142.    ON ERROR DO Multerr
  143.    IF ltype = "1"
  144.      ll_lock=FLOCK()
  145.    ENDIF
  146.    IF ltype = "2"
  147.      ll_lock=RLOCK()
  148.    ENDIF
  149.    ON ERROR
  150. ENDIF
  151. RETURN
  152.  
  153. PROCEDURE Info_Box
  154. PARAMETERS lc_say
  155. ? lc_say
  156. ? REPLICATE("-",LEN(lc_say))
  157. ?
  158. RETURN
  159. * EOP: Info_Box
  160.  
  161. PROCEDURE get_sele
  162. *-- Get the user selection & store BAR into variable
  163. gn_send = BAR()  && Variable for print testing
  164. DEACTIVATE POPUP
  165. RETURN
  166.  
  167. PROCEDURE ShowPick
  168. listval=PROMPT()
  169. IF LEFT(entryflg,1)="B"
  170.    lc_file=POPUP()
  171.    DO &lc_file. WITH "A"
  172.    RETURN
  173. ENDIF
  174. IF TYPE("lc_window")="U"
  175.    ACTIVATE WINDOW ShowPick
  176. ELSE
  177.    ACTIVATE WINDOW &lc_window.
  178. ENDIF
  179. STORE 0 TO ln_ikey,x1,x2
  180. ln_ikey=LASTKEY()
  181. IF ln_ikey=13
  182.    x1=AT(TRIM(listval)+',',lc_fldlst)
  183.    IF x1 = 0
  184.       lc_fldlst=lc_fldlst+TRIM(listval)+','
  185.    ELSE
  186.       x2=AT(',',SUBSTR(lc_fldlst,x1))
  187.       lc_fldlst=STUFF(lc_fldlst,x1,x2,'')
  188.    ENDIF
  189.    CLEAR
  190.    ? lc_fldlst
  191. ENDIF
  192. ACTIVATE SCREEN
  193. RETURN
  194. * EOP: ShowPick
  195.  
  196. PROCEDURE Cleanup
  197. *-- test whether report option was selected
  198. DO CASE
  199. CASE gc_dev='CON'
  200.    WAIT
  201. CASE gc_dev='PRN'
  202.    SET PRINT OFF
  203.    SET PRINTER TO
  204. CASE gc_dev='TXT'
  205.    CLOSE ALTERNATE
  206. ENDCASE
  207. RETURN
  208.  
  209. * EOP: Cleanup
  210.  
  211. PROCEDURE Pause
  212. PARAMETER lc_msg
  213. *-- Parameters : lc_msg = message line
  214. IF TYPE("lc_message")="U"
  215.    gn_error=ERROR()
  216. ENDIF
  217. lc_msg = lc_msg
  218. lc_option='0'
  219. ACTIVATE WINDOW Pause
  220. IF gn_error > 0
  221.    IF TYPE("lc_message")="U"
  222.       @ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
  223.    ELSE
  224.       @ 0,1 SAY [Error # ]+lc_message
  225.    ENDIF
  226. ENDIF
  227. @ 1,1 SAY lc_msg
  228. WAIT " Press any key to continue..."
  229. DEACTIVATE WINDOW Pause
  230. RETURN
  231.  
  232. * EOP: Pause
  233.  
  234. PROCEDURE Multerr
  235. *-- set the global error variable
  236. gn_error=ERROR()
  237. *-- contains error number to test
  238. lc_erno=STR(ERROR(),3)+','
  239. *-- option var.
  240. lc_opt='T'
  241. *-- Dialog box for options Try again and Return to menu.
  242. IF lc_erno $ "108,109,128,129,"
  243.    ACTIVATE WINDOW Pause
  244.    @ 0,2 SAY lc_erno+" "+MESSAGE()
  245.    @ 2,22 SAY "T = Try again, R = Return to menu." GET lc_opt ;
  246. PICTURE "!" VALID lc_opt $ "TR"
  247.    READ
  248.    DEACTIVATE WINDOW Pause
  249.    IF lc_opt = "R"
  250.       RETURN
  251.    ENDIF
  252. ENDIF
  253. *-- Display message and return to menu.
  254. IF .NOT. lc_erno $ "108,109,128,129,"
  255.    DO PAUSE WITH ERROR()
  256.    RETURN
  257. ENDIF
  258. *-- reset global variable
  259. gn_error=0
  260. *-- Try the command again
  261. RETRY
  262. RETURN
  263.  
  264. * EOP: Multerr
  265.  
  266. PROCEDURE Trace
  267. *  Desc: Trace procedure - to let programmer know what module
  268. *           is about to execute and what module has executed.
  269. PARAMETERS p_msg, p_lvl
  270. *-- Parameters : p_msg = message line, p_lvl = trace level
  271. lc_msg = p_msg
  272. ln_lvl = p_lvl
  273. lc_trp = ' '
  274. IF gn_trace < ln_lvl
  275.    RETURN
  276. ENDIF
  277. DEFINE WINDOW trace FROM 11,00 TO 16,79 DOUBLE
  278. DO WHILE lc_trp <> 'Q'
  279.    @ 2,40-LEN(lc_msg)/2 SAY lc_msg
  280.    @ 4,05 SAY 'S - Set trace level, D - Display status, M - display Memory'
  281.    @ 5,05 SAY 'P - Turn printer on, Q - to Quit'
  282.    lc_trp = 'Q'
  283.    @ 5,38 GET lc_trp PICTURE "!"
  284.    READ
  285.    DO CASE
  286.    CASE lc_trp = 'S'
  287.       @ 2,01 CLEAR
  288.       @ 2,33 SAY 'Set trace level'
  289.       @ 4,05 SAY 'Enter trace level to change to:' GET gn_trace PICTURE '#'
  290.       @ 5,05 SAY '            '
  291.       READ
  292.       IF gn_trace=0
  293.          @ 2,01 CLEAR
  294.          @ 3,05 SAY 'Trace is now turned off..To reactivate Trace - Press [F3]'
  295.          @ 4,05 say 'Press any key to continue...'
  296.          WAIT ''
  297.       ENDIF
  298.    CASE lc_trp = 'D'
  299.       DISPLAY STATUS
  300.       WAIT
  301.    CASE lc_trp = 'M'
  302.       DISPLAY MEMORY
  303.       WAIT
  304.    CASE lc_trp = 'P'
  305.       SET PRINT ON
  306.    ENDCASE
  307. ENDDO
  308. SET PRINT OFF
  309. @ 24,79 SAY " "
  310. RELEASE WINDOW trace
  311. RETURN
  312.  
  313. * EOP: Trace
  314.  
  315. PROCEDURE PrintSet
  316. *-- Initialize variables
  317. gc_dev='CON'
  318. lc_choice=' '
  319. gn_pkey=0
  320. gn_send=0
  321.  
  322. DEFINE WINDOW printemp FROM 08,25 TO 17,56
  323.  
  324. DEFINE POPUP SavePrin FROM 10,40
  325. DEFINE BAR 1 OF SavePrin PROMPT " Send output to ..." SKIP
  326. DEFINE BAR 2 OF SavePrin PROMPT REPLICATE(CHR(196),24) SKIP
  327. DEFINE BAR 3 OF SavePrin PROMPT " CON:   Console" MESSAGE "Send output to Screen"
  328. DEFINE BAR 4 OF SavePrin PROMPT " LPT1:  Parallel port 1 " MESSAGE "Send output to LPT1:"
  329. DEFINE BAR 5 OF SavePrin PROMPT " LPT2:  Parallel port 2" MESSAGE "Send output to LPT2:"
  330. DEFINE BAR 6 OF SavePrin PROMPT " COM1:  Serial port 1" MESSAGE "Send output to COM1:"
  331. DEFINE BAR 7 OF SavePrin PROMPT " FILE = REPORT.TXT" MESSAGE "Send output to File Report.txt"
  332. ON SELECTION POPUP SavePrin DO get_sele
  333.  
  334. ACTIVATE POPUP SavePrin
  335. RELEASE POPUP SavePrin
  336.  
  337. IF gn_send = 7
  338.    gc_dev = 'TXT'
  339.    SET ALTERNATE TO REPORT.TXT
  340.    SET ALTERNATE ON
  341. ELSE
  342.    IF .NOT. (gn_send = 3 .OR. LASTKEY() = 27)
  343.       gc_dev = 'PRN'
  344.       temp = SUBSTR("   LPT1LPT2COM1 ",((gn_send-2)-1)*4,4)
  345.       ON ERROR DO prntrtry
  346.       SET PRINTER TO &temp.
  347.       IF gn_pkey <> 27
  348.          SET PRINT ON
  349.       ENDIF
  350.       ON ERROR
  351.    ENDIF
  352. ENDIF
  353. RELEASE WINDOW printemp
  354. RETURN
  355.  
  356. PROCEDURE prntrtry
  357. PRIVATE lc_escape
  358. lc_escape = SET("ESCAPE")
  359. IF .NOT. PRINTSTATUS()
  360.    IF lc_escape = "ON"
  361.       SET ESCAPE OFF
  362.    ENDIF
  363.    gn_pkey = 0
  364.    ACTIVATE WINDOW printemp
  365.    @ 1,0 SAY "Please ready your printer or"
  366.    @ 2,0 SAY "     press ESC to cancel"
  367.    DO WHILE ( .NOT. PRINTSTATUS()) .AND. gn_pkey <> 27
  368.       gn_pkey = INKEY()
  369.    ENDDO
  370.    DEACTIVATE WINDOW printemp
  371.    SET ESCAPE &lc_escape.
  372.    IF gn_pkey <> 27
  373.       RETRY
  374.    ENDIF
  375. ENDIF
  376. RETURN
  377.  
  378. * EOP: PrintSet
  379.  
  380. PROCEDURE Position
  381. IF LEN(DBF()) = 0
  382.    DO Pause WITH "Database not in use. "
  383.    RETURN
  384. ENDIF
  385. SET SPACE ON
  386. SET DELIMITERS OFF
  387. ln_type=0          && sublevel selection
  388. ln_rkey=READKEY()  && test for ESC or Return
  389. ln_rec=RECNO()     && DBF record number
  390. ln_num=0           && for input of a number
  391. ld_date=DATE()     && for input of a date
  392. lc_option='0'      && main option ie. Seek, Goto and Locate
  393. *-- Scope ie. ALL, REST, NEXT <n>
  394. STORE SPACE(10) TO lc_scp
  395. *-- 1 = Character SEEK, 2 = For clause, 3 = While clause
  396. STORE SPACE(40) TO lc_ln1, lc_ln2, lc_ln3
  397. lc_temp=""
  398. @ 0,00 SAY "Index order: "+IIF(""=ORDER(),"Database is in natural order",ORDER())
  399. @ 1,00 SAY "Listed below are the first 16 fields."
  400. lc_temp=REPLICATE(CHR(196),19)
  401. @ 2,0 SAY CHR(218)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp
  402. ln_num=240
  403. DO WHILE ln_num < 560
  404.    lc_temp=FIELD( (ln_num-240)/20 +1)
  405.    @ (ln_num/80),MOD(ln_num,80) SAY CHR(179)+;
  406. lc_temp+SPACE(11-LEN(lc_temp))+;
  407. SUBSTR("= Char  = Date  = Logic = Num   = Float = Memo          ",;
  408. AT(TYPE(lc_temp),"CDLNFMU")*8-7,8)
  409.    ln_num=ln_num+20
  410. ENDDO
  411. ln_num=1
  412.  
  413. DEFINE POPUP Posit1 FROM 8,30
  414. DEFINE BAR 1 OF Posit1 PROMPT " Position by " SKIP
  415. DEFINE BAR 2 OF Posit1 PROMPT REPLICATE(CHR(196),15) SKIP
  416. DEFINE BAR 3 OF Posit1 PROMPT " SEEK Record" MESSAGE "Search on index key" SKIP FOR ""=ORDER()
  417. DEFINE BAR 4 OF Posit1 PROMPT " GOTO Record" MESSAGE "Position to specific record"
  418. DEFINE BAR 5 OF Posit1 PROMPT " LOCATE Record " MESSAGE "Locate record for condition"
  419. DEFINE BAR 6 OF Posit1 PROMPT " Return" MESSAGE "Return without positioning"
  420. ON SELECTION POPUP Posit1 DO get_sele
  421.  
  422. SET CONFIRM ON
  423. DO WHILE lc_option='0'
  424.   ACTIVATE POPUP Posit1
  425.   lc_option = ltrim(str(gn_send))  && for popup
  426.    IF LASTKEY() = 27 .OR. lc_option="6"
  427.       GOTO ln_rec
  428.       EXIT
  429.    ENDIF
  430.    DO CASE
  431.    CASE lc_option='3'
  432.       *-- Seek
  433.       IF LEN(NDX(1))=0 .AND. LEN(MDX(1))=0
  434.          DO Pause WITH "Can't use this option - No index files are open."
  435.          LOOP
  436.       ENDIF
  437.       ln_type=1
  438.       lc_ln1=SPACE(40)
  439.       DEFINE WINDOW Posit2 FROM 8,19 TO 15,62 DOUBLE
  440.       ACTIVATE WINDOW Posit2
  441.       @ 1,1 SAY "Enter the type of expression:" GET ln_type PICT "#" RANGE 1,3
  442.       @ 2,1 SAY "(1=character, 2=numeric and 3=date.)"
  443.       READ
  444.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  445.          SET CONFIRM ON
  446.          @ 3,1 SAY "Enter the key expression to search for:"
  447.          IF ln_type=3
  448.             @ 4,1 GET ld_date PICT "@D"
  449.          ELSE
  450.             IF ln_type=2
  451.                @ 4,1 GET ln_num PICT "##########"
  452.             ELSE
  453.                @ 4,1 GET lc_ln1
  454.             ENDIF
  455.          ENDIF
  456.          READ
  457.          SET CONFIRM OFF
  458.          IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  459.             lc_temp=IIF(ln_type=1,"TRIM(lc_ln1)",IIF(ln_type=2,"ln_num","ld_date"))
  460.             SEEK &lc_temp.
  461.          ENDIF
  462.       ENDIF
  463.       RELEASE WINDOWS Posit2
  464.    CASE lc_option='4'
  465.       *-- Goto
  466.       ln_type=1
  467.       DEFINE POPUP Posit2 FROM 8,30
  468.       DEFINE BAR 1 OF Posit2 PROMPT " GOTO:" SKIP 
  469.       DEFINE BAR 2 OF Posit2 PROMPT REPLICATE(CHR(196),10) SKIP 
  470.       DEFINE BAR 3 OF Posit2 PROMPT " TOP" MESSAGE "GOTO Top of File"
  471.       DEFINE BAR 4 OF Posit2 PROMPT " BOTTOM" MESSAGE "GOTO Bottom of File"
  472.       DEFINE BAR 5 OF Posit2 PROMPT " Record # " MESSAGE "GOTO A Specific Record"
  473.       ON SELECTION POPUP Posit2 DO get_sele
  474.       ACTIVATE POPUP posit2
  475.       ln_type = gn_send
  476.       IF LASTKEY() <> 27
  477.          IF ln_type=5
  478.             DEFINE WINDOW Posit2 FROM 8,26 TO 13,50 DOUBLE
  479.             ACTIVATE WINDOW Posit2
  480.             ln_num=0
  481.             @ 3,1 SAY "Max. Record # = "+LTRIM(STR(RECCOUNT()))
  482.             @ 1,1 SAY "Record to GOTO" GET ln_num PICT "######" RANGE 1,RECCOUNT()
  483.             READ
  484.             IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  485.                GOTO ln_num
  486.             ENDIF
  487.             RELEASE WINDOWS Posit2
  488.          ELSE
  489.            lc_temp=IIF(ln_type=3,"TOP","BOTTOM")
  490.            GOTO &lc_temp.
  491.          ENDIF
  492.       ENDIF
  493.    CASE lc_option='5'
  494.       *-- Locate
  495.       DEFINE WINDOW Posit2 FROM 8,16 TO 14,66 DOUBLE
  496.       ACTIVATE WINDOW Posit2
  497.       @ 1,19 SAY "ie. ALL, NEXT <n>, and REST"
  498.       @ 1,01 SAY "Scope:" GET lc_scp
  499.       @ 2,01 SAY "For:  " GET lc_ln2
  500.       @ 3,01 SAY "While:" GET lc_ln3
  501.       READ
  502.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  503.          lc_temp=TRIM(lc_scp)
  504.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln2)) > 0," FOR "+TRIM(lc_ln2),"")
  505.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln3)) > 0," WHILE "+TRIM(lc_ln3),"")
  506.          IF LEN(lc_temp) > 0
  507.             LOCATE &lc_temp.
  508.          ELSE
  509.             DO Pause WITH "All fields were blank."
  510.          ENDIF
  511.       ENDIF
  512.       RELEASE WINDOW Posit2
  513.    ENDCASE
  514.    IF EOF()
  515.       DO Pause WITH "Record not found."
  516.       GOTO ln_rec
  517.    ENDIF
  518.    IF READKEY()=12 .OR. READKEY()= 268 .OR. LASTKEY()=27  && Esc was hit
  519.       lc_option='0'
  520.    ENDIF
  521. ENDDO
  522. SET DELIMITERS &gc_deli.
  523. SET CONFIRM OFF
  524. RETURN
  525.  
  526. * EOP: Position
  527.  
  528. PROCEDURE Postnhlp
  529. ln_getkey=INKEY()
  530. DO CASE
  531. CASE "SEEK" $ PROMPT()
  532.    HELP SEEK
  533. CASE "GOTO" $ PROMPT()
  534.    HELP GOTO
  535. CASE "LOCATE" $ PROMPT()
  536.    HELP LOCATE
  537. ENDCASE
  538. RETURN
  539. * EOP: Postnhlp
  540.  
  541.  
  542. **********************************************************************
  543. * Program......: MPDEF
  544. * Author.......:          This is an APPLICATION OBJECT.
  545. * Date.........: 12-04-88
  546. * Notice.......: Type information here or greetings to your users.
  547. * dBASE Ver....: See Application menu to use as sign-on banner.
  548. * Generated by.: APGEN version 1.0
  549. * Description..: Customer Application Example
  550.  
  551. * Description..: Defines all menus in the system
  552. **********************************************************************
  553. PROCEDURE MPDEF
  554. IF ISCOLOR()
  555.    SET COLOR OF NORMAL TO W+/B
  556.    SET COLOR OF MESSAGES TO W+/B
  557.    SET COLOR OF TITLES TO W+/B
  558.    SET COLOR OF HIGHLIGHT TO B/W
  559.    SET COLOR OF BOX TO B/W
  560.    SET COLOR OF INFORMATION TO B/W
  561.    SET COLOR OF FIELDS TO B/W
  562. ENDIF
  563. CLEAR
  564.  
  565.  
  566. DEFINE WINDOW FullScr FROM 0,0 TO 24,79 NONE
  567. DEFINE WINDOW Savescr FROM 0,0 TO 21,79 NONE
  568. DEFINE WINDOW Helpscr FROM 0,0 TO 21,79 NONE
  569. DEFINE WINDOW Browscr FROM 1,0 TO 21,79 NONE
  570. IF gn_ApGen=1
  571.    DEFINE WINDOW Exit_App FROM 11,17 TO 15,62 DOUBLE
  572. ENDIF
  573. *-- Window for pause message box
  574. DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
  575.  
  576. ACTIVATE WINDOW FullScr
  577. @ 24,00
  578. @ 23,00 SAY "Loading..."
  579. SET BORDER TO DOUBLE
  580. *-- Bar
  581. DEFINE MENU CUSTMENU MESSAGE "CLASS MENU EXAMPLE"
  582. DEFINE PAD PAD_1 OF CUSTMENU PROMPT "ADD" AT 2,9 
  583. ON SELECTION PAD PAD_1 OF CUSTMENU DO ACT01
  584. DEFINE PAD PAD_2 OF CUSTMENU PROMPT "CHANGE" AT 2,21 
  585. ON SELECTION PAD PAD_2 OF CUSTMENU DO ACT01
  586. DEFINE PAD PAD_3 OF CUSTMENU PROMPT "REPORT" AT 2,37 
  587. ON SELECTION PAD PAD_3 OF CUSTMENU DO ACT01
  588. DEFINE PAD PAD_4 OF CUSTMENU PROMPT "EXIT" AT 2,68 
  589. ON SELECTION PAD PAD_4 OF CUSTMENU DO ACT01
  590. ?? "."
  591. @ 23,00 CLEAR
  592. RETURN
  593. *-- EOP: MPDEF.PRG
  594.  
  595. PROCEDURE 1HELP1
  596. ACTIVATE WINDOW Helpscr
  597. SET ESCAPE OFF
  598. ACTIVATE SCREEN
  599. @ 0,0 CLEAR TO 21,79
  600. @ 1,0 TO 21,79 COLOR B/W
  601. @ 24,00
  602. @ 24,26 SAY "Press any key to continue..."
  603. @ 0,0 SAY ""
  604. ln_row=INKEY()
  605. DO CASE
  606. *-- help for menu CUSTMENU
  607. CASE "01"=gc_prognum
  608.    @ 2,2 SAY "No Help defined."
  609.    ln_row=INKEY(0)
  610. ENDCASE
  611. SET ESCAPE ON
  612. @ 24,00
  613. DEACTIVATE WINDOW Helpscr
  614. RETURN
  615. *-- EOP: 1HELP1
  616.